home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / Src Code / TEEURL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-24  |  4.8 KB  |  164 lines
  1. {******************************************}
  2. {   TeeChart Pro  - URL files retrieval    }
  3. { Copyright (c) 1995-1998 by David Berneda }
  4. {    All Rights Reserved                   }
  5. {******************************************}
  6. {$I teedefs.inc}
  7. unit TeeURL;
  8.  
  9. interface
  10.  
  11. Uses Classes, Windows, Chart;
  12.  
  13. { Read a Chart from a file ( Chart1,'http://www.teemach.com/demo.tee' ) }
  14. Procedure LoadChartFromURL(Var AChart:TCustomChart; Const URL:String);
  15.  
  16. Function DownloadURL(URL:PChar; ToStream:TMemoryStream): HResult;
  17. Procedure ShowMessageUser(Const S:String);
  18.  
  19. implementation
  20.  
  21. Uses TeeProcs, SysUtils, TeeStore, TeeProCo;
  22.  
  23. Procedure LoadChartFromURL(Var AChart:TCustomChart; Const URL:String);
  24. var tmp:Integer;
  25.     l,t,w,h:Integer;
  26.     Stream:TMemoryStream;
  27.     tmpURL:String;
  28. begin
  29.   Stream:=TMemoryStream.Create;
  30.   try
  31.     tmpURL:=URL;
  32.     tmp:=DownloadURL(PChar(tmpURL),Stream);
  33.     if tmp=0 then
  34.     begin
  35.       l:=AChart.Left;
  36.       t:=AChart.Top;
  37.       w:=AChart.Width;
  38.       h:=AChart.Height;
  39.       LoadChartFromStream(TCustomChart(AChart),Stream);
  40.       if csDesigning in AChart.ComponentState then
  41.          AChart.SetBounds(l,t,w,h);
  42.     end
  43.     else
  44.       Raise ChartException.CreateFmt(TeeMsg_CannotLoadChartFromURL,[tmp,URL]);
  45.   finally
  46.     Stream.Free;
  47.   end;
  48. end;
  49.  
  50. Procedure ShowMessageUser(Const S:String);
  51. var St:Array[0..1023] of Char;
  52. begin
  53.   MessageBox(0, StrPCopy(St,S), '', MB_OK or MB_ICONSTOP or MB_TASKMODAL);
  54. end;
  55.  
  56. Const INTERNET_OPEN_TYPE_PRECONFIG=0;
  57.       INTERNET_FLAG_RAW_DATA = $40000000;               { receive the item as raw data }
  58.       INTERNET_FLAG_NO_CACHE_WRITE        = $04000000;  { don't write this item to the cache }
  59.       INTERNET_FLAG_DONT_CACHE            = INTERNET_FLAG_NO_CACHE_WRITE;
  60.  
  61.  
  62. type
  63.   HINTERNET = Pointer;
  64.  
  65. var WinInetDLL:THandle=0;
  66.  
  67.    _InternetOpenA:function(lpszAgent: PAnsiChar; dwAccessType: DWORD;
  68.                           lpszProxy, lpszProxyBypass: PAnsiChar;
  69.                           dwFlags: DWORD): HINTERNET; stdcall;
  70.  
  71.    _InternetOpenURLA:function(hInet: HINTERNET; lpszUrl: PAnsiChar;
  72.                          lpszHeaders: PAnsiChar; dwHeadersLength: DWORD; dwFlags: DWORD;
  73.                          dwContext: DWORD): HINTERNET; stdcall;
  74.  
  75.   _InternetReadFile:function(hFile: HINTERNET; lpBuffer: Pointer;
  76.                          dwNumberOfBytesToRead: DWORD;
  77.                          var lpdwNumberOfBytesRead: DWORD): BOOL; stdcall;
  78.  
  79.   _InternetCloseHandle:function(hInet: HINTERNET): BOOL; stdcall;
  80.  
  81. procedure InitWinInet;
  82. var OldError: Longint;
  83. begin
  84.   OldError:=SetErrorMode(SEM_NOOPENFILEERRORBOX);
  85.   try
  86.     if WinInetDLL = 0 then
  87.     begin
  88.       WinInetDLL:=LoadLibrary('wininet.dll');
  89.       if WinInetDLL <> 0 then
  90.       begin
  91.         @_InternetOpenA      :=GetProcAddress(WinInetDLL,'InternetOpenA');
  92.         @_InternetOpenURLA   :=GetProcAddress(WinInetDLL,'InternetOpenUrlA');
  93.         @_InternetReadFile   :=GetProcAddress(WinInetDLL,'InternetReadFile');
  94.         @_InternetCloseHandle:=GetProcAddress(WinInetDLL,'InternetCloseHandle');
  95.       end;
  96.     end;
  97.   finally
  98.     SetErrorMode(OldError);
  99.   end;
  100. end;
  101.  
  102. Function DownloadURL(URL:PChar; ToStream:TMemoryStream): HResult;
  103. var H1,H2:HINTERNET;
  104.     Buf:Pointer;
  105.     {$IFDEF D4}
  106.     r:DWord;
  107.     {$ELSE}
  108.     r:Integer;
  109.     {$ENDIF}
  110.     MaxSize:Integer;
  111. begin
  112.   {$IFDEF D4}
  113.   result:=$80000000;
  114.   {$ELSE}
  115.   result:=-1;
  116.   {$ENDIF}
  117.   if WinInetDLL=0 then InitWinInet;
  118.   if WinInetDLL<>0 then
  119.   begin
  120.     h1:=_InternetOpenA('Tee',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,INTERNET_FLAG_DONT_CACHE);
  121.     if h1<>nil then
  122.     try
  123.       h2:=_InternetOpenUrlA(h1,URL,nil,{$IFDEF D4}$80000000{$ELSE}-1{$ENDIF},
  124.                               INTERNET_FLAG_DONT_CACHE {or
  125.                               INTERNET_FLAG_RAW_DATA},
  126.       {INTERNET_FLAG_EXISTING_CONNECT} 0);
  127.       if h2<>nil then
  128.       try
  129.         MaxSize:=64*1024;
  130.         Buf:=AllocMem(MaxSize);
  131.         try
  132.           r := 0;
  133.           if _InternetReadFile( h2,Buf,MaxSize,r) then
  134.           begin
  135.             ToStream.Position:=0;
  136.             ToStream.WriteBuffer(Buf^,r);
  137.             ToStream.Position:=0;
  138.             result:=0;
  139.           end
  140.           else result:=GetLastError;
  141.         finally
  142.           FreeMem(Buf,MaxSize);
  143.         end;
  144.       finally
  145.         if not _InternetCloseHandle(h2) then result:=GetLastError;
  146.       end
  147.       else result:=GetLastError;
  148.     finally
  149.       if not _InternetCloseHandle(h1) then result:=GetLastError;
  150.     end
  151.     else result:=GetLastError;
  152.   end
  153.   else ShowMessageUser('Cannot load WinInet.dll to access TeeChart file: '+URL);
  154. end;
  155.  
  156. initialization
  157.   {$IFDEF C3}  
  158.   WinInetDLL:=0; { <-- BCB3 crashes in Win95 if we do not do this... }
  159.   {$ENDIF}
  160. finalization
  161.   if WinInetDLL<>0 then FreeLibrary(WinInetDLL);
  162. end.
  163.  
  164.